perm filename FILER[NYT,SYS] blob
sn#115914 filedate 1974-08-16 generic text, type C, neo UTF8
COMMENT ⊗ VALID 00013 PAGES
C REC PAGE DESCRIPTION
C00001 00001
C00002 00002 Definitions. The file DEFS must be assembled with this file.
C00005 00003 Storage allocations.
C00009 00004 FILER
C00012 00005 CHKTEM
C00014 00006 NEWFIL GETTTY
C00017 00007 END1
C00020 00008 GETCH PUTCH PUTSTR
C00022 00009 UUCODE NXTDG
C00023 00010 CHGNAM INTRPT
C00025 00011 CONVRT
C00027 00012 FIGS
C00030 00013 SETSHF CLRSHF SPE1-7 CKPARA
C00048 ENDMK
C⊗;
;Definitions. The file DEFS must be assembled with this file.
TITLE FILER of AP news
;BUFCNT←←1 ;TYPE OUT NUMBER OF CHARS IN EACH BUFFER FROM TTY12
;IFNDEF DEBUG <DEBUG←←0>
IFNDEF BUFCNT <BUFCNT←←0>
TTY12←←1 TTY←←0 DISK←←0 ;EXACTLY ONE OF THESE SHOULD BE NON-ZERO
IFN TTY12*TTY <TOO MANY INPUT DEVICES!!!!>
IFN TTY12*DISK <TOO MANY INPUT DEVICES!!!!>
IFN TTY *DISK <TOO MANY INPUT DEVICES!!!!>
IFN TTY12+TTY <BUFLN←←30>
IFN DISK <BUFLN←←200>
; ACCUMULATOR ASSIGNMENTS
F←0 ;unused
A←1 ;TEMPORARY AC
B←2 ;TEMPORARY AC
C←3 ;CURRENT CHAR
D←4 ;unused
E←5 ;LF COUNTER--USED TO DETECT END OF STORY
L←6 ;LAST CHAR SEEN
M←7 ;NUMBER OF COLS OUTPUT SO FAR ON CURRENT LINE
N←10 ;NUMBER OF FREE BYTES LEFT IN OUTPUT BUFFER
Q←11 ;unused
R←12 ;unused
W←13 ;W,X,Y,Z ARE USED AS LOOKUP/ENTER BLOCK
X←14
Y←15
Z←16
P←17 ;pdl pointer
I←←0 ;CHANNEL FOR TTY12 INPUT
T←←1 ;CHANNEL FOR OUTPUT TEXT FILE
T1←←2 ;CHANNEL FOR LOOKING UP OLD OUTPUT FILE TO SEE IF IT IS GONE
;Storage allocations.
OBUF: BLOCK 3 ;output buffer header
NOBUFS←←3
DSKBUF: BLOCK NOBUFS*203 ;OUTPUT BUFFER AREA FOR TEXT FILE PASSED TO DOER
IBUF: BLOCK 3 ;input buffer header
NIBUFS←←4
TTYBUF: BLOCK NIBUFS*(BUFLN+3) ;the input buffers for tty12 go here
LPDL←←10
PDL: BLOCK LPDL ;area for stack
DSK17: 217 ;block used for opening the dsk in mode 17 many times
SIXBIT /DSK/ ;200 bit means take error return automatically
0 ;if DISK IS FULL or BAD RETRIEVAL
DONAME: SIXBIT /[DOER]/
DOER: SIXBIT /DSK/ ;block used to start up DOER
SIXBIT /DOER/ ;program name goes here
'DMP',,14 ;USE NEW JOB and dont set JLOG
0 ;normal starting address, normal core assignment
PPN: APPPN
APPPN
ERRBK: SIXBIT /DSK/ ;block used to start up error-handling program
ERRPRG ;program name goes here
'DMP',,0
1 ;NORMAL CORE SIZE, RPG STARTUP (SA+1)
APPPN
SHIFT: 0 ;flag indicating upper or lower shift characters
CRLF: ASCIZ /
/
APNAME: SIXBIT /[-NY-]/
;FILER
FILER: RESET
MOVE P,[IOWD LPDL,PDL];initialize pdl pointer
MOVEI A,INTRPT ;get address of interrupt level module
MOVEM A,JOBAPR↑ ;store it
MOVSI A,INTPTI!INTPAR ;enable interrupts on parity errors
INTENB A, ; and pty input
MOVSI A,INTPTI
INTGEN A, ;generate a pty input int to set the job name
MOVE A,NBRFLR# ;get code indicating number of other filers
JRST .+2(A)
EXIT ;ONE OTHER FILER ALREADY EXISTED
UFATAL 2 ;;;TWO OR MORE OTHER FILERS ALREADY EXISTED
IFN TTY12 <INIT I,411 ;grab AP news line, take error return if not avail
SIXBIT /TTY13/>
IFN TTY+DISK <INIT I,1 >
IFN TTY <SIXBIT /TTY/ >
IFN DISK <SIXBIT /DSK/ >
IBUF
UDELAY 2,4 ;;;INIT FAILED ON TTY12
MOVSI A,000700 ;7-BIT BYTES
MOVEM A,IBUF+1
MOVEI B,TTYBUF ;set up buffers for TTY12 at TTYBUF
EXCH B,JOBFF↑
INBUF I,NIBUFS
MOVEM B,JOBFF ;restore old value of JOBFF
SETZM OLDNAM ;ZERO NAME OF PREVIOUS OUTPUT FILE
SETZM SHIFT
;CHKTEM
INIT T1,210 ;LOOK AT UFD FOR A .TEM FILE TO RENAME TO .TFL
SIXBIT /DSK/
OBUF ;ACTUALLY INPUT BUFFER HEADER
UFATAL 6 ;;;CANT INIT DSK
MOVEI B,DSKBUF
EXCH B,JOBFF↑
INBUF T1,NOBUFS
MOVEM B,JOBFF
MOVE W,PPN
MOVSI X,'UFD'
MOVE Z,[' 1 1']
LOOKUP T1,W ;LOOKUP UFD
UFATAL 10 ;;;CANT LOOKUP UFD
MOVEI A,2
MOVNI B,4
CHKTEM: IN T1,
JRST CHKTE1
STATO T1,20000
UFATAL 12 ;;;DISK INPUT ERROR FROM READING UFD
PUSHJ P,CLSUFD ;CLOSE UFD (T1)
JRST NEWFIL
CHKTE1: ILDB W,OBUF+1 ;get filename from UFD
ILDB X,OBUF+1 ;get extension
ADDM A,OBUF+1 ;skip last two words of each UFD entry
HLLZ X,X
CAMN X,['TEM '] ;is this a .TEM file?
TDNE W,[760000,,400000] ;ANY OF THESE BITS ON MEANS CANT BE OURS
JRST CHKTE2
SETZ Z, ;got one of our .TEM files
OPEN T,DSK17
UFATAL 14 ;;;CANT OPEN DSK
LOOKUP T,W
JRST CHKTE2 ;IF CANT OPEN IT, IGNORE IT
PUSHJ P,CLSUFD ;CLOSE UFD (T1)
JRST END1 ;GO RENAME TO .TFL
CHKTE2: ADDM B,OBUF+2 ;DECREMENT BUFFER HEADER BYTE COUNT
SKIPLE OBUF+2 ;ANYTHING ELSE IN BUFFER?
JRST CHKTE1 ;YES
JRST CHKTEM
CLSUFD: RELEAS T1,
SETZM DSKBUF ;CLEAR OUTPUT BUFFERS FOR HOT
MOVE A,[DSKBUF,,DSKBUF+1]
BLT A,DSKBUF+203*NOBUFS-1
POPJ P,
;NEWFIL GETTTY
NEWFIL: LOCK W, ;LOCK JOB IN CORE!
INIT T,200 ;CREATE A NEW OUTPUT FILE
SIXBIT /DSK/
0
UFATAL 16 ;;;CANT INIT DSK
ACCTIM W, ;USE <DATE>,,<TIME> AS FILENAME
HLRZ X,W ;GET DATE
DAYCNT X, ;CONVERT TO DAYCNT FORMAT
HRL W,X
MOVSI X,'TEM'
SETZB Y,Z
ENTER T,W
AOJA W,[ENTER T,W ;TRY AT MOST TWICE TO DO AN ENTER
UDELAY 1,20 ;;;CANT ENTER OUTPUT FILE (.TEM)
JRST .+1]
MOVEM W,TEMNAM# ;SAVE NAME OF CURRENT FILE
INIT T,200 ;RELEASE NEW FILE AND OPEN IN RA MODE
SIXBIT /DSK/
OBUF,,0
UFATAL 22 ;;;CANT INIT DSK
MOVEI B,DSKBUF
EXCH B,JOBFF↑
OUTBUF T,NOBUFS
MOVEM B,JOBFF
SETZ Z,
LOOKUP T,W ;LOOKUP NEW (EMPTY) FILE
UFATAL 24 ;;;CANT LOOKUP NEW OUTPUT FILE
SETZ Z,
ENTER T,W ;OPEN FOR OUTPUT IN RA MODE
UFATAL 26 ;;;CANT OPEN NEW OUTPUT FILE IN RA MODE
GETTTY: MOVEI E,2
GETTT1: PUSHJ P,GETCH ;GET AP CHAR AND OUTPUT IT
CAIE C,LF ;LOOK FOR 3 STRAIGHT LFs
MOVEI E,3 ;HAVEN'T SEEN ANY YET
SOJGE E,GETTT1
;END1
MOVEI C,200 ;MAKE SURE STORY ENDS WITH NULL
PUSHJ P,PUTCH
OUT T, ;PUT OUT LAST PARTIAL BUFFER
AOSA OBUF+2 ;KEEP BYTE COUNT ACCURATE
UFATAL 30 ;;;OUT UUO FAILED TO OUTPUT LAST RECORD OF STORY
MTAPE T,[SIXBIT/GODMOD/↔17] ;AND UPDATE RETRIEVAL
OPEN T1,DSK17
UFATAL 32 ;;;CANT OPEN DSK
MOVE W,OLDNAM#
MOVSI X,'TFL'
SETZB Z,C
LOOKUP T1,W ;LOOK FOR PREVIOUS OUTPUT FILE
SETO C, ;APPARENTLY NOT THERE
RELEAS T1,
JUMPE C,END2 ;PREVIOUS FILE STILL THERE. DONT START NEW FILE
CLOSE T, ;PREVIOUS FILE GONE. CLOSE CURRENT FILE.
MOVE W,TEMNAM# ;GET NAME OF CURRENT OUTPUT FILE
END1: MOVSI X,'TFL'
SETZB Y,Z
RENAME T,W ;RENAME .TFL←.TEM
UFATAL 34 ;;;CANT RENAME TEM FILE TO TFL
RELEAS T,
MOVEM W,OLDNAM ;SAVE NAME OF THIS FILE
END2: MOVEI B,DOER ;think about starting up DOER
MOVE A,DONAME ;see if a DOER job exists
NAMEIN A,
ORI A,400 ;NOTE THAT NAMEIN FAILED (NO UNIQUE DOER)
CAIN A,401 ;CHECK ERROR CODE
SWAP B, ;NO DOERS. START ONE UP
JUMPE C,GETTTY ;NO NEW FILE YET
JRST NEWFIL ;GO OPEN A NEW OUTPUT FILE
;GETCH PUTCH PUTSTR
GETCH: SOSLE IBUF+2 ;ANY CHARS IN INPUT BUFFER
JRST GETCH1 ;YES. GET ONE.
IN I, ;NO. GET NEW BUFFER
JRST GETCH2
IFN TTY+DISK <
STATZ I,20000 ;END OF FILE?
EXIT ;YES
>;END IFN TTY+DISK
UFATAL 36 ;;;INPUT ERROR FROM TTY12
GETCH2:
IFN TTY12+TTY <
MOVE A,IBUF+2 ;GET NUMBER OF CHARS IN BUFFER
IFN TTY12 <
IFN BUFCNT <
PUSHJ P,NXTDG
OUTCHR [" "]
MOVE A,IBUF+2
>;END IFN BUFCNT
>;END IFN TTY12
CAIGE A,5*BUFLN
JRST GETCH1 ;NOT FULL BUFFER
MOVEI A,[ASCIZ/...
/] ;FULL BUFFER--ASSUME WE MISSED SOME CHARS
PUSHJ P,PUTSTR ;INSERT "...CRLF"
>;END IFN TTY12+TTY
GETCH1: ILDB C,IBUF+1
IFN TTY12 <
TRNE C,140
JRST [MOVEI C,"%" ;140 BIT(S) ON IN AP-LINE CHAR
JRST PUTCH] ;PUT OUT FUNNY CHAR
ADD C,SHIFT ;ACCOUNT FOR CURRENT SHIFT SETTING
XCT CONVRT(C) ;CONVERT FROM AP CODE TO ASCII
>;END IFN TTY12
JUMPE C,GETCH ;FALL INTO PUTCH IF NOT NULL CHAR
PUTCH: SOSG OBUF+2 ;ANY ROOM LEFT IN OUTPUT BUFFER?
OUT T, ;NO. WRITE OUT BUFFER
JRST PUTCH1
UFATAL 40 ;;;DISK OUTPUT ERROR
PUTCH1: IDPB C,OBUF+1
POPJ P,
PUTSTR: TLOA A,440700 ;MAKE A BYTE POINTER
PUTST1: PUSHJ P,PUTCH
ILDB C,A
JUMPN C,PUTST1
POPJ P,
;UUCODE NXTDG
UUCODE: 0
halt .+1
SETO A,
GETLIN A
AOJE A,DET
OUTSTR [ASCIZ /
FILER error #/]
HRRZ A,40 ;get error number
PUSHJ P,NXTDG ;TYPE OUT ERROR NUMBER
EXIT 1,
HALT .
JRST @UUCODE
DET: RESET
MOVE 1,APNAME ;PASS JOB NAME IN AC 1
MOVE 2,40 ; AND ERROR UUO IN AC 2
MOVEI 16,ERRBK
SWAP 16,
EXIT
NXTDG: IDIVI A,=8 ;convert number in A to octal ASCII string
HRLM B,(P)
JUMPE A,.+2
PUSHJ P,NXTDG
HLRZ A,(P)
ADDI A,"0"
OUTCHR A
POPJ P,
;CHGNAM INTRPT
;interrupt level routine to set the job name
CHGNAM: SETZ A, ;zero out own job name
SETNAM A,
SETOM NBRFLR# ;initialize indicator to one other filer
MOVE A,APNAME ;get filer's name from wakeme block
NAMEIN A,
JRST .+2 ;zero or multiple filers exist
DISMIS ;one other filer exists
SETZM NBRFLR ;set indicator to multiple filers
CAIE A,1 ;check error code of NAMEIN
DISMIS ;two or more other filers exist
AOS NBRFLR ;set indicator to no other filers
MOVE A,APNAME ;change job name
SETNAM A,
MOVEI A,200000
INTACM A, ;disable for further pdl ov ints
DISMIS
;interrupt level module
INTRPT: MOVSI C,INTPAR ;enable interrupts only on parity errors
INTENB C,
MOVS A,JOBCNI↑ ;get bit causing interrupt
CAIN A,INTPTI ;is this interrupt to set filer's job name?
JRST CHGNAM ;yes. do it
CAIE A,INTPAR
DISMIS ;IGNORE STRANGE INTERRUPT
UWAIT ;PARITY ERROR. GIVE UP AND GO HOME
JRST 2,@[.+1] ;get out of user-iot
DEBREAK
EXIT ;PARITY ERROR IN FILER
;CONVRT
;LETTERS
CONVRT: JRST GETCH ;0: tape feed
MOVEI C,"E" ;1
MOVEI C,LF ;2: elevate→line feed
MOVEI C,"A" ;3
MOVEI C," " ;4: SPACE.
MOVEI C,"S" ;5
MOVEI C,"I" ;6
MOVEI C,"U" ;7
MOVEI C,CR ;10: CARRIAGE RETURN
MOVEI C,"D" ;11
MOVEI C,"R" ;12
MOVEI C,"J" ;13
MOVEI C,"N" ;14
MOVEI C,"F" ;15
MOVEI C,"C" ;16
MOVEI C,"K" ;17
MOVEI C,"T" ;20
MOVEI C,"Z" ;21
MOVEI C,"L" ;22
MOVEI C,"W" ;23
MOVEI C,"H" ;24
MOVEI C,"Y" ;25
MOVEI C,"P" ;26
MOVEI C,"Q" ;27
MOVEI C,"O" ;30
MOVEI C,"B" ;31
MOVEI C,"G" ;32
JRST SETSHF ;33: SHIFT
MOVEI C,"M" ;34
MOVEI C,"X" ;35
MOVEI C,"V" ;36
JRST CLRSHF ;37: UNSHIFT
;FIGS
JRST GETCH ;00
MOVEI C,"3" ;01
MOVEI C,LF ;02: PAPER FEED→LINE FEED
MOVEI C,"-" ;43
MOVEI C," " ;SPACE
JRST GETCH ;05: BELL
MOVEI C,"8" ;46
MOVEI C,"7" ;47
MOVEI C,CR ;50
MOVEI C,"$" ;51
MOVEI C,"4" ;52
MOVEI C,47 ;13: SINGLE QUOTE
MOVEI C,"," ;54: comma
MOVEI C,"!" ;55: EXCLAMATION POINT
MOVEI C,":" ;16: COLON
MOVEI C,"(" ;17: LEFT PAREN
MOVEI C,"5" ;60
MOVEI C,42
MOVEI C,")" ;61
MOVEI C,"2" ;63
JRST GETCH ;64
MOVEI C,"6" ;65
MOVEI C,"0" ;66
MOVEI C,"1" ;75
MOVEI C,"9" ;70
MOVEI C,"?" ;72
MOVEI C,"&" ;74
JRST SETSHF ;SHIFT
MOVEI C,"." ;PERIOD
MOVEI C,"/"
MOVEI C,";"
JRST CLRSHF
;SETSHF CLRSHF SPE1-7 CKPARA
CLRSHF: TDZA C,C
SETSHF: MOVEI C,40
MOVEM C,SHIFT
JRST GETCH
END FILER